home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / Class / Accessor / Faster.pm < prev   
Encoding:
Perl POD Document  |  2007-07-11  |  2.4 KB  |  106 lines
  1. package Class::Accessor::Faster;
  2. use base 'Class::Accessor';
  3. use strict;
  4. $Class::Accessor::Faster::VERSION = '0.31';
  5.  
  6. =head1 NAME
  7.  
  8. Class::Accessor::Faster - Even faster, but less expandable, accessors
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.   package Foo;
  13.   use base qw(Class::Accessor::Faster);
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. This is a faster but less expandable version of Class::Accessor::Fast.
  18.  
  19. Class::Accessor's generated accessors require two method calls to accompish
  20. their task (one for the accessor, another for get() or set()).
  21.  
  22. Class::Accessor::Fast eliminates calling set()/get() and does the access itself,
  23. resulting in a somewhat faster accessor.
  24.  
  25. Class::Accessor::Faster uses an array reference underneath to be faster.
  26.  
  27. Read the documentation for Class::Accessor for more info.
  28.  
  29. =cut
  30.  
  31. my %slot;
  32. sub _slot {
  33.     my($class, $field) = @_;
  34.     my $n = $slot{$class}->{$field};
  35.     return $n if defined $n;
  36.     $n = keys %{$slot{$class}};
  37.     $slot{$class}->{$field} = $n;
  38.     return $n;
  39. }
  40.  
  41. sub new {
  42.     my($proto, $fields) = @_;
  43.     my($class) = ref $proto || $proto;
  44.     my $self = bless [], $class;
  45.  
  46.     $fields = {} unless defined $fields;
  47.     for my $k (keys %$fields) {
  48.         my $n = $class->_slot($k);
  49.         $self->[$n] = $fields->{$k};
  50.     }
  51.     return $self;
  52. }
  53.  
  54. sub make_accessor {
  55.     my($class, $field) = @_;
  56.     my $n = $class->_slot($field);
  57.     return sub {
  58.         return $_[0]->[$n] if @_ == 1;
  59.         return $_[0]->[$n] = $_[1] if @_ == 2;
  60.         return (shift)->[$n] = \@_;
  61.     };
  62. }
  63.  
  64.  
  65. sub make_ro_accessor {
  66.     my($class, $field) = @_;
  67.     my $n = $class->_slot($field);
  68.     return sub {
  69.         return $_[0]->[$n] if @_ == 1;
  70.         my $caller = caller;
  71.         $_[0]->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'");
  72.     };
  73. }
  74.  
  75.  
  76. sub make_wo_accessor {
  77.     my($class, $field) = @_;
  78.     my $n = $class->_slot($field);
  79.     return sub {
  80.         if (@_ == 1) {
  81.             my $caller = caller;
  82.             $_[0]->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'");
  83.         } else {
  84.             return $_[0]->[$n] = $_[1] if @_ == 2;
  85.             return (shift)->[$n] = \@_;
  86.         }
  87.     };
  88. }
  89.  
  90.  
  91. =head1 AUTHORS
  92.  
  93. Copyright 2007 Marty Pauley <marty+perl@kasei.com>
  94.  
  95. This program is free software; you can redistribute it and/or modify it under
  96. the same terms as Perl itself.  That means either (a) the GNU General Public
  97. License or (b) the Artistic License.
  98.  
  99. =head1 SEE ALSO
  100.  
  101. L<Class::Accessor>
  102.  
  103. =cut
  104.  
  105. 1;
  106.